VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsBEUpdater"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'################################################################################################################
'THIS UTILITY IS RELEASED UNDER THE LGPL.  PLEASE INCLUDE A CREDIT FOR CASEY EYRING IN YOUR SOFTWARE IF YOU
'USE THIS UTILITY AND FIND IT HELPFUL.  PLEASE SEND QUESTIONS OR COMMENTS TO CASEY_EYRING@YAHOO.COM.
'
'COPYRIGHT 2009 CASEY EYRING, CASEY_EYRING@YAHOO.COM
'
'SPECIAL THANKS TO: CyberCow (IsTableOpen)
'                   LPurvis & WildBird (currentdb issue)
'                   SMerrill (adding and deleting relationships)
'################################################################################################################

Option Compare Database
Option Explicit
Option Base 0

'If the developer wants to implement a custom test as to whether back-end
' versions are out of date, set the .UseCustomFileVersions property
' to true, which will enable the .OnIsUpdateRequired event to fire.
' This will also eliminate the need for two ABEU forms.
Public Event OnIsUpdateRequired(ByVal DBFilename As String, ByRef Required As Boolean)

Dim mrsMaster       As ADODB.Recordset
Dim mrsFields       As ADODB.Recordset
Dim mrsProperties   As ADODB.Recordset
Dim mrsDatabases    As ADODB.Recordset

'DIALOG BOXES
Private Const cstTEXT_PERFORM_UPDATE_PROMPT     As String _
= "Your data file is not up to date with this data file.  Update now?"
'What the update dialog box should say

Private Const cstTEXT_PERFORM_UPDATE_TITLE      As String _
= "Perform Update?"
'What the title of the Update Dialog box should say

Private Const cstTEXT_UPDATE_COMPLETE           As String _
= "Your data file has been updated to the latest version."
'Message to display after the update has been completed

Private Const cstTEXT_UPDATER_ERROR_MSG_VERSION_BELOW_ONE As String _
= "Data files must be at least version 1"

Public UseCustomFileVersions As Boolean
Public UseSilentUpgrade      As Boolean

Private Sub Class_Initialize()
    UseCustomFileVersions = False ' Default of the property
    UseSilentUpgrade = False
    LoadDefaults
End Sub

Public Sub LoadDefaults()
    'Load the default settings from an INI file and set them in the databases table
    Dim strPath     As String
    Dim strPassword As String
    Dim strUserName As String
    
    Call LoadRecordsets
    With mrsDatabases
        Do While .EOF = False
            strPath = GetDBSettings(!DatabaseID, "Path")
            strUserName = GetDBSettings(!DatabaseID, "UserName")
            strPassword = GetDBSettings(!DatabaseID, "Password")
            !Path = strPath
            !UserName = strUserName
            !Password = strPassword
            .Update
            .MoveNext
        Loop
    End With
    Call UnLoadRecordsets
End Sub

Private Function PropertyIsNotIgnored(strPropertyName As String) As Boolean
    'Created: 2010-03-24 by Shaun Merrill
    'A list of properties to ignore - we can't set these properties ever!
    Dim IgnoredProperties As String
    IgnoredProperties = "|CollatingOrder|SourceField|" _
                      & "SourceTable|DataUpdatable|" _
                      & "OriginalValue|ValidateOnSet|" _
                      & "VisibleValue|Value|ForeignName|"
    PropertyIsNotIgnored = (InStr(IgnoredProperties, strPropertyName) = 0)
End Function

Public Sub BackupDBs()
    'Backs up the databases into a folder with today's date and time
    Dim fs As Object
    Dim strBackupDir  As String
    Dim strDBFileName As String
    
    Call acbInitMeter("Backing Up Databases", False)
    
    Set fs = CreateObject("Scripting.FileSystemObject")

    Call LoadDefaults
    Call LoadRecordsets
    
    On Error GoTo Err_Handler
    
    strBackupDir = BEUpdater_Backup_Dir & Format(Now(), "YYYYMMDD") & Format(Now(), "hhmmss") & "\"
    Debug.Print "Backing Up Databases to " & strBackupDir
    With mrsDatabases
        Do While .EOF = False
            fs.CopyFile !Path, strBackupDir & GetNamePart(!Path)
            Debug.Print "   ...backed up " & !dbName & " to " & strBackupDir
            Call acbUpdateMeter((.AbsolutePosition / .RecordCount) * 100)
            .MoveNext
        Loop
    End With
    
Exit_Here:
    Set fs = Nothing
    
    Call UnLoadRecordsets
    Call acbCloseMeter
Exit Sub

Err_Handler:
    With Err
        Select Case .Number
        Case 76 ' directory not found, create it
            fs.CreateFolder strBackupDir
            Resume
        Case Else
            .Raise .Number, .Source, .Description, .HelpFile, .HelpContext
        End Select
    End With
End Sub

Private Function GetNamePart(strIn As String) As String
    ' Comments : Returns the name and extension of a fully qualified file name
    ' Parameters: strIn - path and name to parse
    ' Returns : file name + extension
    '
    Dim intCounter As Integer
    Dim strTmp As String
    
    For intCounter = Len(strIn) To 1 Step -1
        If Mid(strIn, intCounter, 1) <> "\" Then
            strTmp = Mid(strIn, intCounter, 1) & strTmp
        Else
            Exit For
        End If
    Next intCounter
    
    GetNamePart = strTmp
    
End Function

Private Sub LoadRecordsets( _
                  Optional myCursorType As CursorTypeEnum = adOpenForwardOnly _
                , Optional myLockTypeEnum As LockTypeEnum = adLockOptimistic _
            )
    Set mrsMaster = New ADODB.Recordset
    Set mrsFields = New ADODB.Recordset
    Set mrsProperties = New ADODB.Recordset
    Set mrsDatabases = New ADODB.Recordset

'    myCursorType   = adOpenForwardOnly
'    myLockTypeEnum = adLockPessimistic

    mrsMaster.Open BEUpdater_Master_Table_Name _
    , CurrentProject.Connection _
    , myCursorType _
    , myLockTypeEnum
    
    mrsFields.Open BEUpdater_Fields_Table_Name _
    , CurrentProject.Connection _
    , myCursorType _
    , myLockTypeEnum
    
    mrsProperties.Open BEUpdater_Properties_Table_Name _
    , CurrentProject.Connection _
    , myCursorType _
    , myLockTypeEnum
    
    mrsDatabases.Open BEUpdater_Databases_Table_Name _
    , CurrentProject.Connection _
    , myCursorType _
    , myLockTypeEnum
    
End Sub

Private Sub UnLoadRecordsets()
    mrsMaster.Close
    mrsFields.Close
    mrsProperties.Close
    mrsDatabases.Close
    
    Set mrsMaster = Nothing
    Set mrsFields = Nothing
    Set mrsProperties = Nothing
    Set mrsDatabases = Nothing
End Sub

Public Function fDoesRelationExist(db As Database, strRelationName As String) As Boolean
    Dim r As Relation
    For Each r In db.relations
        If r.Name = strRelationName Then
            fDoesRelationExist = True
            Exit Function
        End If
    Next r
End Function

Public Function fDoesTableExist(dbsMyDB As Database, strTableName As String) As Boolean
    Dim t As TableDef

    For Each t In dbsMyDB.TableDefs
        If t.Name = strTableName Then
            fDoesTableExist = True
            Exit Function
        End If
    Next t

    fDoesTableExist = False
End Function

Public Function fDoesFieldExist(dbsMyDB As Database, strTableName As String, strFieldName As String) As Boolean
    Dim fld As Field

    If fDoesTableExist(dbsMyDB, strTableName) = False Then
        fDoesFieldExist = False
        Exit Function
    End If
    
    For Each fld In dbsMyDB.TableDefs(strTableName).Fields
        If fld.Name = strFieldName Then
            fDoesFieldExist = True
            Exit Function
        End If
    Next fld

    fDoesFieldExist = False
End Function

'Public Function GetIgnoredTableNames(blnIgnoreSystemTables As Boolean, blnIgnoreUpdaterTables As Boolean) As String()
'    'Returns a list of system table names and Updater_Tables if blnIncludeUpdaterTables is true
'    Dim strIgnoreList() As String
'
'    If blnIgnoreSystemTables = True And blnIgnoreUpdaterTables = False Then
'        ReDim strIgnoreList(5)
'        strIgnoreList(0) = "MSysAccessObjects"
'        strIgnoreList(1) = "MSysAccessXML"
'        strIgnoreList(2) = "MSysACEs"
'        strIgnoreList(3) = "MSysObjects"
'        strIgnoreList(4) = "MSysQueries"
'        strIgnoreList(5) = "MSysRelationships"
'    ElseIf blnIgnoreSystemTables = True And blnIgnoreUpdaterTables = True Then
'        ReDim strIgnoreList(9)
'        strIgnoreList(0) = "MSysAccessObjects"
'        strIgnoreList(1) = "MSysAccessXML"
'        strIgnoreList(2) = "MSysACEs"
'        strIgnoreList(3) = "MSysObjects"
'        strIgnoreList(4) = "MSysQueries"
'        strIgnoreList(5) = "MSysRelationships"
'        strIgnoreList(6) = BEUpdater_Fields_Table_Name
'        strIgnoreList(7) = BEUpdater_Master_Table_Name
'        strIgnoreList(8) = BEUpdater_Properties_Table_Name
'        strIgnoreList(9) = BEUpdater_Databases_Table_Name
'    Else
'        ReDim strIgnoreList(0) 'Nothing on ignore list
'    End If
'
'    GetIgnoredTableNames = strIgnoreList
'End Function

Public Function GetDataFileVersions(Optional intDatabaseID As Integer) As Variant
    'Called by: getLowestDBDataFileVersion
    'Not called if .UseCustomFileVersions is True
    
    'Returns all data file versions as an array (DATABASE ID, VERSION)
    'If intDatabaseID is supplied, then it will return that database's _
                                               version ID as an integer
    Dim prp As Property
    Dim db As Database
    Dim intDataFileVersions() As Integer
    Dim i As Integer
    Dim varVersion As Variant
    
    Call LoadDefaults  'Make sure the records in the databases _
                        are all current with INI file
    Call LoadRecordsets
    
    On Error GoTo Err_Handler
    
    If Not intDatabaseID = 0 Then 'get data file version of a specific database
        Set db = OpenDB(intDatabaseID)
        varVersion = db.Properties("DataFileVersion")
        GetDataFileVersions = varVersion
        GoTo ExitFunc
    End If
    
    'Count how many databases there are, redim the array to the proper length
    mrsDatabases.MoveFirst
    Do While mrsDatabases.EOF = False
        i = i + 1
        mrsDatabases.MoveNext
    Loop
    mrsDatabases.MoveFirst
    ReDim intDataFileVersions(i - 1, 1)
    i = 0
    
    Do While mrsDatabases.EOF = False
        Set db = OpenDB(mrsDatabases!DatabaseID)
        intDataFileVersions(i, 0) = mrsDatabases!DatabaseID
        intDataFileVersions(i, 1) = db.Properties("DataFileVersion")
        i = i + 1
        mrsDatabases.MoveNext
    Loop
        
    GetDataFileVersions = intDataFileVersions()
    
ExitFunc:
    Call UnLoadRecordsets
Exit Function

Err_Handler:
    If Err.Number = 3270 Then 'property not found
        If Not intDatabaseID = 0 Then
            varVersion = BEUpdater_START_AT_VERSION
        Else
            intDataFileVersions(i, 1) = BEUpdater_START_AT_VERSION
        End If
        Resume Next
    Else
        Err.Raise Err.Number
    End If
End Function

Public Function GetLowestDBDataFileVersion() As Integer
    'Called by: UpdateRequired()
    'Not called if .UseCustomFileVersions is true
    
    Dim intVersionsList() As Integer
    Dim intLowestVersion  As Integer
    Dim i As Integer
    
    intVersionsList = GetDataFileVersions()
    intLowestVersion = GetHighestDataFileVersion
    
    For i = 0 To UBound(intVersionsList)
        If intVersionsList(i, 1) < intLowestVersion Then _
                        intLowestVersion = intVersionsList(i, 1)
    Next i
    
    GetLowestDBDataFileVersion = intLowestVersion
End Function

Private Function UpdateRequired() As Boolean
    
    'Called by: RunAccessBEUpdater
    
    'Returns TRUE if an update is required
    'Returns FALSE if all data files are up to date
    
    'REVISION: 2010-03-25 Shaun Merrill - Added UseCustomFileVersions parameter
    
    Dim intSteps        As Integer
    Dim iDB             As Integer
    If Not Me.UseCustomFileVersions Then
        intSteps = DCount("DatabaseID", BEUpdater_Master_Table_Name, "DataFileVersion > " & GetLowestDBDataFileVersion)
        
        UpdateRequired = (intSteps > 0) 'If there are any steps, an update is required
        Debug.Print "UPDATE REQUIRED: " & CStr(intSteps > 0)
    Else
        RaiseEvent OnIsUpdateRequired("Any Database", UpdateRequired)
    End If
End Function

Public Sub RunAccessBEUpdater()
    'THE MAIN SUBROUTINE THAT WILL LOOK AT ALL OF THE UPDATES THAT NEED TO BE PERFORMED
    'STARTING WITH THE TABLES AND THEN PERFORM THOSE ACTIONS
    
    Const UseCustomFileVersions As Boolean = True
    
    Dim rsMaster                    As New ADODB.Recordset
    Dim rsDatabases                 As New ADODB.Recordset
    Dim rsFields                    As New ADODB.Recordset
    Dim db                          As Database
    Dim vResponse                   As VbMsgBoxResult
    Dim intActionType               As BEUpdater_ActionTypes
    Dim intDatabaseAndVersionList() As Integer
    Dim intProcessDBList()          As Integer 'Databases to use for this iteration
    Dim strMasterSQL                As String
    Dim strFieldsSQL                As String
    Dim strDatabaseIDsSQL           As String
    Dim strWhere                    As String
    Dim blnRunUpdate                As Boolean
    Dim blnBackupDBs                As Boolean
    Dim blnOK                       As Boolean
    Dim intCommandID                As Integer
    Dim intNewVersionNumber         As Integer
    Dim iDB                         As Integer
    Dim intLowestVersionNumber      As Integer
    Dim isRequired                  As Boolean
        
    Set db = CurrentDb
    
    'CHECK IF AN UPDATE IS REQUIRED
    If UpdateRequired() Then
        If Me.UseSilentUpgrade Then
            vResponse = vbOK
        Else
            vResponse = MsgBox("Your data file is out of date.  " _
                             & "Would you like to update it now?" _
                             , vbOKCancel, "Update?")
        End If
    Else
        Exit Sub
    End If
    
    If Not vResponse = vbOK Then
        MsgBox BEUpdater_Must_Upgrade_To_Continue_Prompt _
             , vbOKOnly + vbInformation _
             , BEUpdater_Must_Upgrade_To_Continue_WinTitle
        Application.Quit
    Else
        blnRunUpdate = True
        Call BackupDBs
    End If
    
    'RUN THE UPDATE
    Do While UpdateRequired = True
        'Get the lowest data file version that we are using
        intLowestVersionNumber = GetLowestDBDataFileVersion
        
        'Find out what data files are still at this lowest data file number.
        'If they are at the lowest data file version number, _
         then add it to the intProcessDBList() to be processed.
        With rsDatabases
            .Open _
                  BEUpdater_Databases_Table_Name _
                , CurrentProject.Connection, adOpenStatic, adLockReadOnly
            
            ReDim intProcessDBList(.RecordCount - 1)
            'Max Number in list is equal to the number of databases we have
            
            iDB = 0
            Do While .EOF = False
                If Me.UseCustomFileVersions Then
                
                    RaiseEvent OnIsUpdateRequired(!dbName, isRequired)
                    
                    If isRequired Then
                        intProcessDBList(iDB) = !DatabaseID
                        iDB = iDB + 1
                    End If
                Else
                    'Get data file version for this specific DB. _
                     If it = the lowest file version number, we need to update it
                     
                    If GetDataFileVersions(!DatabaseID) = intLowestVersionNumber Then
                        intProcessDBList(iDB) = !DatabaseID
                        iDB = iDB + 1
                    End If
                End If
                .MoveNext
            Loop
            .Close
        End With
        
        strDatabaseIDsSQL = ""
        For iDB = 0 To UBound(intProcessDBList)
            If Not intProcessDBList(iDB) = 0 Then
                strDatabaseIDsSQL = strDatabaseIDsSQL & " OR (DatabaseID = " & intProcessDBList(iDB) & ")"
            End If
        Next iDB
        'Strip off leading " AND "
        strDatabaseIDsSQL = right(strDatabaseIDsSQL, Len(strDatabaseIDsSQL) - 4)
    
        strMasterSQL = "SELECT * FROM " _
                        & BEUpdater_Master_Table_Name _
                        & " WHERE (DataFileVersion = " & intLowestVersionNumber _
                        & " AND (" & strDatabaseIDsSQL & "))"
        
        rsFields.Open BEUpdater_Fields_Table_Name _
            , CurrentProject.Connection, adOpenStatic, adLockReadOnly
    
        With rsMaster
        
            .Open strMasterSQL _
                , CurrentProject.Connection, adOpenStatic, adLockReadOnly
            
            Call acbInitMeter("Updating to Version " & intLowestVersionNumber, False)
            
            Do While .EOF = False
                blnOK = acbUpdateMeter(((.AbsolutePosition / .RecordCount) * 100) - 1)
                intActionType = !Action
                intCommandID = !CommandID
             
                Select Case intActionType
                Case CreateTableAction
                
                    Call PROCESS_CreateTableCommand(intCommandID)
                    
                Case DeleteTableAction
                
                    Call Cmd_DeleteTableX(OpenDB(!DatabaseID), !TableName)
                    
                Case RenameTableAction
                
                    Call RenameTableX(OpenDB(!DatabaseID), !TableName, !NewObjectName)
                    
                Case CreateFieldAction
                
                    Call PROCESS_CreateFieldCommand(intCommandID)
                    
                Case RenameFieldAction
                
                    rsFields.Filter = "CommandID = " & intCommandID
                    Call RenameFieldX(OpenDB(!DatabaseID), !TableName, rsFields!FieldName, !NewObjectName)
                    
                Case DeleteFieldAction
                
                    rsFields.Filter = "CommandID = " & intCommandID
                    Call Cmd_DeleteFieldX(OpenDB(!DatabaseID), !TableName, rsFields!FieldName)
                    
                Case SetDBProperty, SetTableProperty, SetFieldProperty
                
                    Call PROCESS_SetPropertyCommand(intCommandID)
                    
                Case RunSQLAction
                
                    Call RunSQLCmd(OpenDB(!DatabaseID), !SQLCommand)
                    
                End Select
                .MoveNext
            Loop
            .Close
        End With
        rsFields.Close
        
        'Add 1 to Version Number
        For iDB = 0 To UBound(intProcessDBList)
            If Not intProcessDBList(iDB) = 0 Then
                Call SetPropertyX( _
                          OpenDB(intProcessDBList(iDB)) _
                        , "DataFileVersion" _
                        , dbInteger _
                        , intLowestVersionNumber + 1 _
                    )
            End If
        Next iDB
        
        Call acbCloseMeter
        
        
        
    Loop
    
    MsgBox "Your data file has been successfully updated to version " & intLowestVersionNumber + 1, vbOKOnly, "Success!"
End Sub

Public Sub RecalcSortOrder()
    Dim rs As New ADODB.Recordset
    Dim intSortOrder As Long
    Dim lngVersionsList() As Integer
    Dim i As Variant
    
    lngVersionsList = fGetDataFileVersionsList()
    
    rs.Open "SELECT * FROM " & BEUpdater_Master_Table_Name & " ORDER BY DataFileVersion, SortOrder;", CurrentProject.Connection, adOpenStatic, adLockOptimistic
    
    For Each i In lngVersionsList
        rs.Filter = "DataFileVersion = " & lngVersionsList(i - 1)
        
        If Not rs.RecordCount = 0 Then rs.MoveFirst
        
        intSortOrder = 1
        
        Do While rs.EOF = False
            rs!SortOrder = intSortOrder
            intSortOrder = intSortOrder + 1
            rs.Update
            rs.MoveNext
        Loop
    
    Next i
    
    rs.Close
End Sub

Public Function ParseArrayForComboBox(vntArray As Variant, Optional strHeader As String) As String
    'Parses an array for a combo box.
    'Include a trailering ; for the header...
    'E.g.: If you want the 2 headers NAME and OPTION then strHeader should
    'look like "Name;Header;"
    Dim strTemp As String
    strTemp = strHeader & ParseArray(vntArray, ";", Chr(34), Chr(34))
'    ParseArrayForComboBox = Left(strTemp, Len(strTemp) - 1)
    ParseArrayForComboBox = strTemp
End Function

Public Function ParseArray(vntArray As Variant, strSeparatorChar As String, Optional strStartChar As String, Optional strEndChar As String) As String
    Dim strTemp As String
    Dim vntTemp As Variant
    
On Error GoTo Err_Handler
    
    For Each vntTemp In vntArray
        strTemp = strTemp & strStartChar & vntTemp & strEndChar & strSeparatorChar
    Next vntTemp
    
    ParseArray = strTemp
    Exit Function

Err_Handler:
    Select Case Err.Number
    Case 92 'vntArray is empty
        ParseArray = ""
        Exit Function
    Case Else
        Err.Raise Err.Number
    End Select
End Function

Public Function fGetDataFileVersionsList() As Integer()
    Dim rs As New ADODB.Recordset
    Dim intTemp() As Integer
    Dim i As Integer
    Dim intRecCnt As Integer
    
    i = 0
    
    rs.Open "SELECT DISTINCT " & BEUpdater_Master_Table_Name & ".DataFileVersion FROM " & BEUpdater_Master_Table_Name & " ORDER BY DataFileVersion;", CurrentProject.Connection, adOpenStatic, adLockReadOnly
    intRecCnt = rs.RecordCount
    
    If intRecCnt = 0 Then
        'no file versions in list
        ReDim intTemp(0) As Integer
        intTemp(0) = BEUpdater_START_AT_VERSION
    Else
        ReDim intTemp(intRecCnt - 1) As Integer
    End If
    
    Do While rs.EOF = False
       intTemp(i) = Int(rs!DataFileVersion)
       rs.MoveNext
       i = i + 1
    Loop
    
    rs.Close
    
    fGetDataFileVersionsList = intTemp()
End Function

Private Sub RunSQLCmd(dbsMyDB As Database, strSQL As String)
    dbsMyDB.Execute strSQL
End Sub

Public Function AllDBsValid() As Boolean
    'Checks if all the databases are valid
    Dim IsValid As BEUpdater_ValidDataFile
    
    Call LoadDefaults 'Load all of the database settings from our INI file into BEUpdater_Databases_Table_Name
    Call LoadRecordsets
    Do While mrsDatabases.EOF = False
        IsValid = ValidateDBPath(mrsDatabases!Path, mrsDatabases!UserName, mrsDatabases!Password)
        If (IsValid = abInvalidPath) Or (IsValid = abInvalidCredentials) Then
            AllDBsValid = False
            GoTo ExitFunc
        End If
        mrsDatabases.MoveNext
    Loop
    AllDBsValid = True
ExitFunc:
    Call UnLoadRecordsets
End Function

Public Function ValidateDBPath(strPath As String, Optional strUserName As String, Optional strPassword As String) As BEUpdater_ValidDataFile
    'CHECKS IF A DATABASE IS VALID
    'RETURNS 1 IF VALID, 0 IF INVALID, 2 IF VALID, BUT THE USERNAME/PASSWORD ARE INVALID
    Dim blnValidPath As Boolean
    Dim blnValidCredentials As Boolean
    Dim intReturn As BEUpdater_ValidDataFile
    Dim fs
    Dim wrkJet As Workspace
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    blnValidPath = fs.FileExists(strPath)

    'check login credentials here, for now just assume they work
    blnValidCredentials = True
    'set wrkJet =
    
    If blnValidPath Then
        If blnValidCredentials Then
            intReturn = abValid
        Else
            intReturn = abInvalidPath
        End If
    Else
        intReturn = abInvalidCredentials
    End If
    
    ValidateDBPath = intReturn
End Function

Public Function GetDBSettings(intDatabaseID As Integer, strSetting As String) As String
    'Setting can be Path, UserName, or Password
    'If the setting does not exist, it will be created in the INI file with the default settings!
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    
    Dim strSettingValue As String
    
    If Not (strSetting = "Path" Or strSetting = "UserName" Or strSetting = "Password") Then
        Err.Raise vbObjectError + ERR_OLD_AND_NEW_FIELD_NAMES_MATCH, "clsBEUpdater.GetDBSettings", "The setting was invalid." & vbCrLf & "The setting may only be 'Path', 'UserName' or 'Password'"
        Exit Function
    End If
    
    strSettingValue = INIGetSettingString_TSB("DATABASE_" & intDatabaseID, strSetting, fGetINIPath)
    GetDBSettings = strSettingValue
End Function

Private Function fGetINIPath() As String
    Dim strTemp As String
    Dim strCurDir As String
    
    strCurDir = left(CurrentDb.Name, Len(CurrentDb.Name) - Len(GetNamePart(CurrentDb.Name)))
    strTemp = BEUpdater_INI_File_Path
    strTemp = Replace(strTemp, "{app}", strCurDir)
    
    fGetINIPath = strTemp
End Function

Public Function SetDBSetting(intDatabaseID As Integer, strSetting As String, strSettingValue As String) As Integer
    'Setting can be Path, UserName, or Password
    'This also updates the local database
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    Dim intResult As Integer
    
    If Not (strSetting = "Path" Or strSetting = "UserName" Or strSetting = "Password") Then
        Err.Raise vbObjectError + ERR_OLD_AND_NEW_FIELD_NAMES_MATCH, "clsBEUpdater.SetDBSettings", "Invalid Setting"
        Exit Function
    End If
    intResult = INIWriteSetting_TSB("DATABASE_" & intDatabaseID, strSetting, strSettingValue, fGetINIPath)
    If intResult = 0 Then
        Err.Raise vbObjectError + ERR_ERROR_WRITING_TO_INI_FILE, "clsBEUpdater.SetDBSetting", "Error writing INI File"
    End If
    
    'Save this setting into the database as well
    Call LoadRecordsets
    mrsDatabases.Filter = "DatabaseID = " & intDatabaseID
    If Not mrsDatabases.RecordCount = 0 Then
        mrsDatabases.Fields(strSetting).Value = strSettingValue
        mrsDatabases.Update
    End If
    Call UnLoadRecordsets
    
    SetDBSetting = intResult
End Function

Public Function OpenDB(intDatabaseID As Integer, Optional blnExclusive As Boolean) As Database
        
    'Called by: GetDataFileVersions
    'Not called if .UseCustomFileVersions is true

    Dim intTemp As Integer
    Dim strPath As String
    Dim fs
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If intDatabaseID = -1 Then
        Set OpenDB = CurrentDb
        Exit Function
    End If
    
    strPath = GetDBSettings(intDatabaseID, "Path")
    
    'Check if file exists.  If not, ask to open it
    If Not ValidateDBPath(strPath) = abValid Then
        DoCmd.OpenForm BEUpdater_Form_Prefixes & "Welcome-ConfigSingleDB", acNormal, , , , acDialog, intDatabaseID
    End If

    If Not ValidateDBPath(strPath) = abValid Then
        Err.Raise vbObjectError + ERR_TABLENAME_CANNOT_BE_BLANK, "OpenDB", "Database path not valid"
    End If
    Set OpenDB = OpenDatabase(strPath)
End Function

Public Sub PROCESS_SetPropertyCommand(intCommandID As Integer)
    Dim dbsMyDB As Database
    Dim intAction As Integer
    Dim cdb As Database
    Dim blnSetInCurrentDB As Boolean 'set this property in the current db as well?
    
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    
    'In the future, we can replace these 3 tables with 1 SQL statement
    Call LoadRecordsets(adOpenStatic, adLockReadOnly)
    mrsMaster.Filter = "CommandID = " & intCommandID
    
    Set dbsMyDB = OpenDB(mrsMaster!DatabaseID, False) 'Doesn't need to be exclusive to set a property
    Set cdb = CurrentDb
    
    blnSetInCurrentDB = mrsMaster!LinkToCurrentDB
    
    intAction = mrsMaster!Action
    Select Case intAction
    
    Case SetDBProperty
        mrsProperties.Filter = "CommandID = " & intCommandID
        Call SetPropertyX(dbsMyDB, mrsProperties!PropertyName, mrsProperties!PropertyType, mrsProperties!PropertyValue)
        If blnSetInCurrentDB Then Call SetPropertyX(cdb, mrsProperties!PropertyName, mrsProperties!PropertyType, mrsProperties!PropertyValue)
        
    Case SetTableProperty
        mrsProperties.Filter = "CommandID = " & intCommandID
        Call SetPropertyX(dbsMyDB, mrsProperties!PropertyName, mrsProperties!PropertyType, mrsProperties!PropertyValue, mrsMaster!TableName)
        If blnSetInCurrentDB Then Call SetPropertyX(cdb, mrsProperties!PropertyName, mrsProperties!PropertyType, mrsProperties!PropertyValue, mrsMaster!TableName)
        
    Case SetFieldProperty
        mrsFields.Filter = "CommandID = " & intCommandID
        mrsProperties.Filter = "CommandID = " & intCommandID
        Call SetPropertyX(dbsMyDB, mrsProperties!PropertyName, mrsProperties!PropertyType, mrsProperties!PropertyValue, mrsMaster!TableName, mrsFields!FieldName)
        If blnSetInCurrentDB Then Call SetPropertyX(cdb, mrsProperties!PropertyName, mrsProperties!PropertyType, mrsProperties!PropertyValue, mrsMaster!TableName, mrsFields!FieldName)
        
    Case Else
        Err.Raise vbObjectError + ERR_INVALID_ACTION_TYPE_ON_SETPROPERTY, "PROCESS_SetPropertyCommand", "The action type " & intAction & " was invalid."
    End Select
    
    Call UnLoadRecordsets
    
    Set dbsMyDB = Nothing
    Set cdb = Nothing
End Sub

Private Sub PROCESS_CreateTableCommand(intCommandID As Integer)
    'PROCESSES A CREATETABLE COMMAND.  LOOKS AT THE FIELDS AND CREATES ANY FIELDS NEEDED TO BE MADE
    'THEN IT GOES THROUGH AND SET ALL THE PROPERTIES AFTER THE FIELD AS ALREADY BEEN CREATED
    'IN CASE THE PROPERTY IS ONLY ALLOWED TO BE SET ONCE IT IS PART OF THE RECORDSET
  
    Dim tdfNew As TableDef
    Dim strNewTableName As String
    
    Dim dbsMyDB As Database
    Dim fldMyField As Field
    Dim prpLoop As Property
    Dim blnExitLoop As Boolean
    Dim i As Integer
    Dim blnLinkToCurrentDB As Boolean
    
    Dim vntPropertiesList() As Variant 'TableName, FieldName, FieldID
    Dim intCounter As Integer
      
    Call LoadRecordsets(adOpenStatic, adLockReadOnly)
    
    mrsMaster.Filter = "CommandID = " & intCommandID
    
    'Make sure the command exists
    If mrsMaster.RecordCount = 0 Then
        GoTo Err_CommandDoesNotExist
    End If
    
    Set dbsMyDB = OpenDB(mrsMaster!DatabaseID, False)
    
    'Make sure the command is a create table command
    If Not mrsMaster!Action = CreateTableAction Then
        GoTo Err_CreateTableCommandExpected
    End If
    
    strNewTableName = mrsMaster!TableName
    
    'get fields that need to be opened
    mrsFields.Filter = "CommandID = " & intCommandID

    If mrsFields.RecordCount = 0 Then
        GoTo Err_NoFieldsInTable
        Exit Sub
    End If
        
    ReDim vntPropertiesList(mrsFields.RecordCount - 1, 2) 'redim list with # records
    
    ' Create a new TableDef object.
    Set tdfNew = dbsMyDB.CreateTableDef(strNewTableName)
            
    Do While mrsFields.EOF = False
        Set fldMyField = Cmd_CreateFieldDefX(mrsFields!FieldID)
        tdfNew.Fields.Append fldMyField 'Appends a field object with all of the properties to this table def
        vntPropertiesList(intCounter, 0) = strNewTableName
        vntPropertiesList(intCounter, 1) = mrsFields!FieldName
        vntPropertiesList(intCounter, 2) = mrsFields!FieldID
        intCounter = intCounter + 1
        mrsFields.MoveNext
    Loop

    dbsMyDB.TableDefs.Append tdfNew
    
    blnLinkToCurrentDB = mrsMaster!LinkToCurrentDB
    
    'Loop through properties... try to set them again
    
    For intCounter = 0 To UBound(vntPropertiesList)
        mrsProperties.Filter = "FieldID = " & vntPropertiesList(intCounter, 2) 'set filter = field id
        
        Do While mrsProperties.EOF = False
            Call SetPropertyX(dbsMyDB, mrsProperties!PropertyName, mrsProperties!PropertyType, mrsProperties!PropertyValue, CStr(vntPropertiesList(intCounter, 0)), CStr(vntPropertiesList(intCounter, 1)))
            mrsProperties.MoveNext
        Loop
    Next intCounter
    
    If blnLinkToCurrentDB = True Then
        DoCmd.TransferDatabase acLink, "Microsoft Access", dbsMyDB.Name, acTable, strNewTableName, strNewTableName
    End If
    
    dbsMyDB.Close
    Set tdfNew = Nothing
    
    Call UnLoadRecordsets

Exit Sub
Err_CommandDoesNotExist:
    'Table does not exist
    MsgBox "Table does not exist!" 'THROW EXCEPTION!!!
    Exit Sub
Err_CreateTableCommandExpected:
    'A create table command was expected and not found
    MsgBox "'A create table command was expected and not found"
    Exit Sub
Err_NoFieldsInTable:
    'There are no fields in the table to create (Need at least 1 field to create a table)
    MsgBox "There were no fields in the table to create (At least 1 field is required to save a new table)"
    Exit Sub
Err_Handler:
    Select Case Err.Number
    Case 3219 'invalid operation (probably tried to set a read-only property
        Resume Next
    Case 3001 ' invalid argument -- not sure what this is
        Resume Next
    Case 3270 'property not found -- we must create it
        Set prpLoop = dbsMyDB.TableDefs(tdfNew.Name).Fields(fldMyField.Name).CreateProperty()
        dbsMyDB.TableDefs(tdfNew.Name).Fields(fldMyField.Name).Properties.Append (prpLoop)
        Resume Next
    Case 3313 'Cannot place this validation expression on this field. (Error 3313)
        Debug.Print "ERROR 3313: "; prpLoop.Name
        Resume Next
    Case 3267 'Property can be set only when the Field is part of a Recordset object's Fields collection. (Error 3267)
        Debug.Print "ERROR 3267: "; prpLoop.Name
        Resume Next
    Case Else
        Debug.Print "Other Error: "; prpLoop.Name
        Resume Next
       ' Err.Raise (Err.Number)
    End Select
End Sub

Private Sub PROCESS_CreateFieldCommand(intCommandID As Integer)
    'Creates a field in an EXISTING TABLE ONLY (Not newly created tables).
    
    'Revision: 2010-02-01 SMerrill: used the Action constants instead of magic numbers.
    '                               I believe this fixes some bugs.

    Dim dbsMyDB As Database
    Dim tdfMyTable As TableDef
        
    'Open the master updater table to get the commands
    Call LoadRecordsets(adOpenStatic, adLockReadOnly)
    
    'Filter the update command we are dealing with
    mrsMaster.Filter = "CommandID = " & intCommandID
    mrsFields.Filter = "CommandID = " & intCommandID
    
    'Make sure the command exists
    If mrsMaster.RecordCount = 0 Then
        GoTo Err_CommandDoesNotExist
    End If
    
    Set dbsMyDB = OpenDB(mrsMaster!DatabaseID, False)
    
    'Make sure the command exists in the fields table
    If mrsFields.RecordCount = 0 Then
        GoTo Err_CommandDoesNotExistInFieldsTable
    End If
    
    'Make sure the command is a create field command
'   If Not mrsMaster!Action = 210 Then
    If Not mrsMaster!Action = CreateFieldAction Then     'SMerrill8
        GoTo Err_CreateFieldCommandExpected
    End If
        
    Set dbsMyDB = CurrentDb 'will need to set this dynamically in the future
            
    ' Create a new TableDef object.
    Set tdfMyTable = dbsMyDB.TableDefs(mrsMaster!TableName)
            
    Do While mrsFields.EOF = False
        tdfMyTable.Fields.Append Cmd_CreateFieldDefX(mrsFields!FieldID) 'Appends a field object with all of the properties to this table def
        mrsFields.MoveNext
    Loop

    dbsMyDB.Close
    Set tdfMyTable = Nothing

    Call UnLoadRecordsets

Exit Sub
Err_CommandDoesNotExist:
    'Create Field Command not exist
    MsgBox "The command does not exist!" 'THROW EXCEPTION!!!
    Exit Sub
Err_CommandDoesNotExistInFieldsTable:
    'No field object in Fields Table
    MsgBox "No data exists in the fields table!" 'THROW EXCEPTION!!!
    Exit Sub
Err_CreateFieldCommandExpected:
    'A create table command was expected and not found
    MsgBox "A create field command was expected and not found"
    Exit Sub
End Sub

Private Function Cmd_CreateFieldDefX(intFieldID As Integer) As Field
    'Creates and returns a field object with all of the properties required
    Dim rsFields As New ADODB.Recordset
    Dim rsProperties As New ADODB.Recordset
    Dim fldMyField As New Field
    Dim prp As Property
    Dim blnSetProperty As Boolean
    Dim i As Integer
    
    rsFields.Open BEUpdater_Fields_Table_Name, CurrentProject.Connection, adOpenStatic, adLockReadOnly
    rsProperties.Open BEUpdater_Properties_Table_Name, CurrentProject.Connection, adOpenStatic, adLockReadOnly
    
    'Find the update command we are dealing with
    rsFields.Filter = "FieldID = " & intFieldID
    
    'Make sure the command exists
    If rsFields.RecordCount = 0 Then
        'GoTo Err_CreateFieldCommandDoesNotExist
    End If
        
    fldMyField.Name = rsFields!FieldName
        
    rsProperties.Filter = "FieldID = " & intFieldID
    
    On Error GoTo Err_Handler
    Do While rsProperties.EOF = False
        If PropertyIsNotIgnored(rsProperties!PropertyName) Then
            fldMyField.Properties(rsProperties!PropertyName) = rsProperties!PropertyValue
        End If
        'Debug.Print "Success>Set property '", rsProperties!PropertyName, "' to '", rsProperties!PropertyValue, "' for FIELD '", rsFields!FieldName, "'"
        rsProperties.MoveNext
    Loop
    
    Set Cmd_CreateFieldDefX = fldMyField

Exit Function
Err_Handler:
    Select Case Err.Number
    Case 3219 'invalid operation (probably tried to set a read-only property
        Resume Next
    Case 3001 ' invalid argument -- not sure what this is
        Resume Next
    Case 3270 'property not found -- we must create it
       ' On Error Resume Next
        'Debug.Print "CREATED PROPERTY"; rsProperties!PropertyName
        Resume Next
    Case Else
        Err.Raise (Err.Number)
    End Select
End Function

Private Sub RenameFieldX(dbsMyDB As Database, strTableName As String, strFieldName As String, strNewFieldName As String)
    'Renames a field in an EXISTING TABLE
    On Error GoTo Err_Handler:
    
    dbsMyDB.TableDefs(strTableName).Fields(strFieldName).Name = strNewFieldName
    dbsMyDB.Close
    
Exit Sub
Err_Handler:
    'Create Field Command not exist
    MsgBox Err.Description & Err.Number
    Exit Sub
End Sub

Private Sub Cmd_DeleteFieldX(dbsMyDB As Database, strTableName As String, strFieldName As String)
    'DELETES A FIELD IN AN EXISTING TABLE
    Dim fldMyField As Field
    
    On Error GoTo Err_Handler

    dbsMyDB.TableDefs(strTableName).Fields.Delete (strFieldName)
    dbsMyDB.Close
    
    Exit Sub

Err_Handler:
    Debug.Print "error on CMD_DeleteFieldX", Err.Number, Err.Description
End Sub

Public Sub Cmd_DeleteTableX(dbsMyDB As Database, strTableName As String)
    'DELETES A TABLE
    Dim cdb As Database
    Dim t As TableDef
    
    If strTableName = "" Then Exit Sub
    
    Set cdb = CurrentDb
    
    If fDoesTableExist(cdb, strTableName) Then
       ' If cdb.TableDefs(strTableName).Attributes(dbAttachedTable) = True Then
            'Delete the table in this database if its a linked table and it exists
       '     cdb.TableDefs.Delete strTableName
      '  End If
    End If
    
    dbsMyDB.TableDefs.Delete (strTableName)
 
    dbsMyDB.Close
End Sub

Private Sub RenameTableX(dbsMyDB As Database, strTableName As String, strNewTableName As String)
    dbsMyDB.TableDefs(strTableName).Name = strNewTableName
 
    dbsMyDB.Close
End Sub

Public Sub SetPropertyX(dbsMyDB As Database, strPropName As String, intPropType As Integer, vntPropValue As Variant, Optional strTableName As String, Optional strFieldName As String)
    Dim p As Property
    Dim intSetType As BEUpdater_SetTypes
    'Sets a property on a database, table, or field.
On Error GoTo Err_Handler
    If Not strFieldName = "" And Not strTableName = "" Then 'Set property for a field
        intSetType = SetTypeField
        dbsMyDB.TableDefs(strTableName).Fields(strFieldName).Properties(strPropName) = vntPropValue
    ElseIf strFieldName = "" And Not strTableName = "" Then 'set property for a table
        intSetType = SetTypeTable
        dbsMyDB.TableDefs(strTableName).Properties(strPropName) = vntPropValue
    ElseIf strFieldName = "" And strTableName = "" Then 'set property for a database
        intSetType = SetTypeDatabase
        dbsMyDB.Properties(strPropName) = vntPropValue
    Else 'Field without table, or some other invalid choice chosen
        intSetType = SetTypeInvalid
        'raise error?
    End If
    
Exit Sub
Err_Handler:
    Select Case Err.Number
    Case 3219 'invalid operation (probably tried to set a read-only property
        Debug.Print Err.Number, Err.Description, Err.Source, strPropName
        Resume Next
    Case 3001 ' invalid argument -- not sure what this is
        Debug.Print "error 3001"
        'Resume Next
    Case 3270 'property not found -- we must create it
        Select Case intSetType
        Case SetTypeDatabase
            Set p = dbsMyDB.CreateProperty(strPropName, intPropType, vntPropValue)
            dbsMyDB.Properties.Append p
        Case SetTypeTable
            Set p = dbsMyDB.TableDefs(strTableName).CreateProperty(strPropName, intPropType, vntPropValue)
            dbsMyDB.TableDefs(strTableName).Properties.Append p
        Case SetTypeField
            Set p = dbsMyDB.TableDefs(strTableName).Fields(strFieldName).CreateProperty(strPropName, intPropType, vntPropValue)
            dbsMyDB.TableDefs(strTableName).Fields(strFieldName).Properties.Append p
        End Select
        Resume Next
    Case 3313 'Cannot place this validation expression on this field. (Error 3313)
        Debug.Print "ERROR 3313: "
        Resume Next
    Case 3267 'Property can be set only when the Field is part of a Recordset object's Fields collection. (Error 3267)
        Debug.Print "ERROR 3267: "
        Resume Next
    Case Else
        Err.Raise (Err.Number)
        Resume Next
    End Select
End Sub

Public Function ListFields(dbsMyDB As Database, strTable As String) As String()
    'Returns a list of fields in the database
    Dim fld As Field
    Dim strTemp() As String
    Dim intFieldCount As Integer
    Dim i As Integer
    
    If fDoesTableExist(dbsMyDB, strTable) = False Then
        Exit Function 'Table doesn't exist so no fields exist
    End If
    
    intFieldCount = dbsMyDB.TableDefs(strTable).Fields.Count
    ReDim strTemp(intFieldCount - 1)
    
    For Each fld In dbsMyDB.TableDefs(strTable).Fields
        strTemp(i) = fld.Name
        i = i + 1
    Next fld
    
    ListFields = strTemp
End Function

Private Function DecodeRelationAttributes(att As Long) As String
    'I used these constants for speed
    Const aCDel         As Long = DAO.RelationAttributeEnum.dbRelationDeleteCascade
    Const aCUpd         As Long = DAO.RelationAttributeEnum.dbRelationUpdateCascade
    Const aDontEnforce  As Long = DAO.RelationAttributeEnum.dbRelationDontEnforce
    Const aInh          As Long = DAO.RelationAttributeEnum.dbRelationInherited
    Const aLeft         As Long = DAO.RelationAttributeEnum.dbRelationLeft
    Const aRight        As Long = DAO.RelationAttributeEnum.dbRelationRight
    Const aUnique       As Long = DAO.RelationAttributeEnum.dbRelationUnique

    Dim sRet As String
        sRet = sRet & "DeleteCascade=" & CStr((att And aCDel) = aCDel) & ";"
        sRet = sRet & "UpdateCascade=" & CStr((att And aCUpd) = aCUpd) & ";"
        sRet = sRet & "DontEnforce=" & CStr((att And aDontEnforce) = aDontEnforce) & ";"
        sRet = sRet & "Inherited=" & CStr((att And aInh) = aInh) & ";"
        sRet = sRet & "Left=" & CStr((att And aLeft) = aLeft) & ";"
        sRet = sRet & "Right=" & CStr((att And aRight) = aRight) & ";"
        sRet = sRet & "Unique=" & CStr((att And aUnique) = aUnique) & ";"
    DecodeRelationAttributes = sRet
End Function

Public Function ListRelations(db As Database) As String()
    Dim r               As DAO.Relation
    Dim ret()           As String
    ReDim ret(db.relations.Count)
    Dim iRel            As Integer
    Dim sRet            As String
    iRel = 0
    For Each r In db.relations
        ret(iRel) = r.Name & ";"
        iRel = iRel + 1
    Next r
    ListRelations = ret
End Function

Public Function TableShouldNotBeIgnored( _
                      strTableName As String _
                    , Optional blnIgnoreSystemTables As Boolean = True _
                    , Optional blnIgnoreUpdaterTables As Boolean = True _
                ) As Boolean
    Dim ret As Boolean
    'CREATED: 2010-03-25 by Shaun Merrill to replace GetIgnoredTableNames()
    '         because there were far too many custom strings
    
    ret = False
    Select Case True ' if any of the boolean tests below pass
    Case CBool(left(strTableName, 4) = "MSys")
        ret = blnIgnoreSystemTables
    Case CBool(left(strTableName, Len("BEUpdater_")) = "BEUpdater_")
        ret = blnIgnoreUpdaterTables
    End Select
    TableShouldNotBeIgnored = ret
End Function

Public Function ListTableDefs(dbsMyDB As Database _
                , Optional blnIncludeSystemTables As Boolean = False _
                , Optional blnIncludeUpdaterTables As Boolean = False _
                , Optional blnIncludeLinkedTables As Boolean = False _
            ) As String()
            
    'REVISION: 2010-03-25 Shaun Merrill:
    '          Refactored to use TableShouldNotBeIgnored()
    
    'Returns a list of table defs in a database as a string array
    Dim t                   As TableDef
    Dim strRet()            As String
    Dim intCounter          As Integer
    Dim intNumberOfTables   As Integer
    Dim intRedimValue       As Integer
    Dim iTable              As Integer
    
  '  Dim strIgnoreList()     As String
  '  Dim i                   As Integer
  '  Dim blnAddTableToArray  As Boolean
    
    'THIS ISN'T CORRECT HERE
  '  strIgnoreList = GetIgnoredTableNames( _
  '                        Not blnIncludeSystemTables _
  '                      , Not blnIncludeUpdaterTables _
  '                  )
    intRedimValue = -1
    
    'Iterate through each table name to get a count of how many tables we have
    Call acbInitMeter("Loading Tables...", False)
    intNumberOfTables = dbsMyDB.TableDefs.Count
    If Not intNumberOfTables > 0 Then intNumberOfTables = 1
    
    For Each t In dbsMyDB.TableDefs
        intCounter = intCounter + 1
 '       blnAddTableToArray = True
 '       For i = 0 To UBound(strIgnoreList)
 '           If t.Name = strIgnoreList(i) Then
 '               blnAddTableToArray = False
 '               Exit For
 '           End If
 '       Next i
        
        'CHECK IF THIS IS A LINKED TABLE OR NOT
'        If t.Attributes = dbAttachedTable Then  'this is a linked table
'            If blnIncludeLinkedTables = False Then blnAddTableToArray = False
'        End If
        
 '      If blnAddTableToArray Then
 
        If TableShouldNotBeIgnored(t.Name) Then
            intRedimValue = intRedimValue + 1
        End If
        acbUpdateMeter ((intCounter / intNumberOfTables))
    Next t
    
    If intRedimValue = -1 Then intRedimValue = 0
    ReDim strRet(intRedimValue)
    
    'Add those tables to strRet
    For Each t In dbsMyDB.TableDefs
 '       blnAddTableToArray = True
 '       For i = 0 To UBound(strIgnoreList)
 '           If t.Name = strIgnoreList(i) Then
 '               blnAddTableToArray = False
 '               Exit For
 '           End If
 '       Next i
        
        'CHECK IF THIS IS A LINKED TABLE OR NOT
'        If t.Attributes = dbAttachedTable Then  'this is a linked table
'            If blnIncludeLinkedTables = False Then blnAddTableToArray = False
'        End If
        
 '      If blnAddTableToArray Then
        If TableShouldNotBeIgnored(t.Name) Then
            strRet(iTable) = t.Name
            iTable = iTable + 1
        End If
    Next t
    
    ListTableDefs = strRet
    Call acbCloseMeter
End Function

Public Sub AddToScript_ConvertFieldObjToUpdateScript( _
                fldMyField As Field _
                , intDatabaseID As Integer _
                , strTableName As String _
                , strFieldName As String _
                , intDataFileVersion As Integer _
                , Optional intSortOrder As Integer _
                , Optional blnLinkToCurrentDB As Boolean = True _
            )
    Dim intCommandID As Integer
    Dim intFieldID   As Integer
    Dim prpLoop      As Property
    
    'Revision: 2010-02-01 SMerrill: used the Action constants instead of magic numbers.
    'Revision: 2010-03-24 SMerrill: Refactored to use AddToScript_Properties
    
    Call LoadRecordsets
    
    If intSortOrder = 0 Then intSortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    With mrsMaster
        .AddNew
        !DatabaseID = intDatabaseID
        !DataFileVersion = intDataFileVersion
        !SortOrder = intSortOrder
        !Action = CreateFieldAction
        !TableName = strTableName
        !LinkToCurrentDB = blnLinkToCurrentDB
        intCommandID = !CommandID
        .Save
    End With
    
    With mrsFields
        .AddNew
        !CommandID = intCommandID
        !FieldName = strFieldName
        intFieldID = !FieldID
        .Save
    End With
    
    AddToScript_Properties fldMyField.Properties, intCommandID, intFieldID
    
    Call UnLoadRecordsets
End Sub

Private Sub AddToScript_Properties( _
                  daoProperties As DAO.Properties _
                , intCommandID As Integer _
                , intFieldID As Integer _
            )
    On Error GoTo Error_Handler
    
    'Created: 2010-03-24 SMerrill
    'Assumes recordsets are already loaded
    Dim p As DAO.Property

    For Each p In daoProperties
        If PropertyIsNotIgnored(p.Name) Then
            With mrsProperties
                .AddNew
                !CommandID = intCommandID
                !FieldID = intFieldID
                !PropertyName = p.Name
                !PropertyValue = p.Value
                !PropertyType = p.Type
                .Save
            End With
        End If
    Next p
    
Exit_Here:
    Exit Sub
    
Error_Handler:
    With Err
    Select Case .Number
    '3267: Property can only be set when it is part of a recordset
    '3219: Invalid Operation
    '3251: Operation is not supported for this type of object.
    Case 3267, 3219, 3251
        Resume Next
    Case Else
        Debug.Print "AddToScript_Properties Error #" & CStr(.Number), ": ", .Description
        .Raise .Number, .Source, .Description, .HelpFile, .HelpContext
    End Select
    End With
End Sub

Private Sub AddToScript_Fields(daoFields As DAO.Fields, intCommandID As Integer)
    Dim f           As DAO.Field
    Dim intFieldID  As Integer
    Dim X           As Integer
   'Created: 2010-03-24 SMerrill: Further refactored to use AddToScript_Properties
    'Assumes recordsets are already loaded

    With mrsFields
    For Each f In daoFields
        Call acbUpdateMeter(X / daoFields.Count * 100)
        X = X + 1

        .AddNew
        !CommandID = intCommandID
        !FieldName = f.Name
        intFieldID = !FieldID
        .Save
        
        AddToScript_Properties f.Properties, intCommandID, intFieldID
        
    Next f
    End With
End Sub

Public Sub AddToScript_ConvertTableDefToUpdateScript( _
            tdfMyTable As TableDef _
            , intDatabaseID As Integer _
            , strTableName As String _
            , intDataFileVersion As Integer _
            , Optional intSortOrder As Integer _
            , Optional blnLinkToCurrentDB As Boolean _
        )
        
    'Converts a tableDef Object into an update script
    Dim intCommandID    As Integer
    
    'Revision: 2010-02-01 SMerrill: used the Action constants instead of magic numbers.
    'Revision: 2010-03-24 SMerrill: Refactored to use AddToScript_Fields
On Error GoTo Err_Handler
    
    Call acbInitMeter("Adding Table To Script...", False)
    
    If intSortOrder = 0 Then intSortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    
    Call LoadRecordsets
    
    With mrsMaster
        .AddNew
        !Action = CreateTableAction
        !TableName = strTableName
        !SortOrder = intSortOrder
        !DatabaseID = intDatabaseID
        !DataFileVersion = intDataFileVersion
        !LinkToCurrentDB = blnLinkToCurrentDB
        intCommandID = !CommandID
        .Save
    End With
    AddToScript_Fields tdfMyTable.Fields, intCommandID

Exit_Here:
    Call UnLoadRecordsets
    Call acbCloseMeter
Exit Sub

Err_Handler:
    Select Case Err.Number
    '3267: Property can only be set when it is part of a recordset
    '3219: Invalid Operation
    '3251: Operation is not supported for this type of object.
    Case 3267, 3219, 3251
        Resume Next
    Case Else
        Debug.Print Err.Number, ": ", Err.Description
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End Select
End Sub

Public Sub AddToScript_RenameTable(intDatabaseID As Integer _
                    , intDataFileVersion As Integer _
                    , strOldTableName As String _
                    , strNewTableName As String _
                    , Optional intSortOrder As Integer _
                    )
    'ADD A RENAMING ACTION TO THE SCRIPT
    
    'Revision: 2010-02-01 SMerrill: used the Action constants instead of magic numbers.
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    
    Call LoadRecordsets
    If intSortOrder = 0 Then intSortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    If strNewTableName = strOldTableName Then Err.Raise vbObjectError + ERR_OLD_AND_NEW_TABLE_NAMES_MATCH, "AddToScript_RenameTable", "The new table name cannot be the same as the old table name."
    mrsMaster.AddNew
    mrsMaster!DatabaseID = intDatabaseID
    mrsMaster!DataFileVersion = intDataFileVersion
    mrsMaster!SortOrder = intSortOrder
    mrsMaster!Action = RenameTableAction    'SMerrill8
    mrsMaster!TableName = strOldTableName
    mrsMaster!NewObjectName = strNewTableName
    mrsMaster.Save
    Call UnLoadRecordsets
End Sub

Public Sub AddToScript_RenameField(intDatabaseID As Integer _
                    , intDataFileVersion As Integer _
                    , strTableName As String _
                    , strOldFieldName As String _
                    , strNewFieldName As String _
                    , Optional intSortOrder As Integer _
                    )
    'ADD A RENAMING ACTION TO THE SCRIPT
    'Revision: 2010-02-01 SMerrill: used the Action constants instead of magic numbers.
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    
    If strNewFieldName = strOldFieldName Then
        Err.Raise vbObjectError + ERR_OLD_AND_NEW_FIELD_NAMES_MATCH, "AddToScript_RenameField", "New Field Names must be different than Old Field Names when creating a 'Rename Field' command"
    End If
    
    If intDatabaseID = 0 Or strNewFieldName = "" Or strOldFieldName = "" Or strTableName = "" Then
        Err.Raise vbObjectError + ERR_BLANK_IDENTIFIER_NAME, "AddToScript_RenameField", "Required criterion not entered. (Blank DatabaseID, TableName, NewFieldName or OldFieldName.)"
    End If
    
    
    Call LoadRecordsets
    If intSortOrder = 0 Then intSortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    mrsMaster.AddNew
    mrsMaster!DatabaseID = intDatabaseID
    mrsMaster!DataFileVersion = intDataFileVersion
    mrsMaster!SortOrder = intSortOrder
    mrsMaster!Action = RenameFieldAction 'SMerrill8
    mrsMaster!TableName = strTableName
    mrsMaster!NewObjectName = strNewFieldName
    
    mrsFields.AddNew
    mrsFields!CommandID = mrsMaster!CommandID
    mrsFields!FieldName = strOldFieldName
    
    mrsMaster.Save
    mrsFields.Save
    Call UnLoadRecordsets
End Sub

Public Sub AddToScript_DeleteRelation( _
    intDatabaseID As Integer, _
    intDataFileVersion As Integer, _
    strRelationName As String, _
    Optional intSortOrder As Integer = 0)
    
    'Created 2010-03-24 by Shaun Merrill
    
    'ADD A DELETE RELATION ACTION TO THE SCRIPT
    
    If intDatabaseID = 0 Or strRelationName = "" Then
        Err.Raise vbObjectError + ERR_BLANK_IDENTIFIER_NAME, _
        "AddToScript_DeleteRelation", "Required criterion not entered. (Blank DatabaseID, or RelationName.)"
    End If
        
    Call LoadRecordsets
    If intSortOrder = 0 Then intSortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    With mrsMaster
        .AddNew
        !DatabaseID = intDatabaseID
        !DataFileVersion = intDataFileVersion
        !SortOrder = intSortOrder
        !Action = DeleteRelationshipAction
        !TableName = strRelationName
        .Save
    End With
    Call UnLoadRecordsets

End Sub

Public Sub AddToScript_DeleteField( _
        intDatabaseID As Integer, _
        intDataFileVersion As Integer, _
        strTableName As String, _
        strFieldName As String, _
        Optional intSortOrder As Integer)
        
    'ADD A DELETE FIELD ACTION TO THE SCRIPT
    
    'Revision: 2010-02-01 SMerrill8: used the Action constants instead of magic numbers.
    'Revision: 2010-02-01 SMerrill8: Used ErrorEnum Constants
    
    If intDatabaseID = 0 Or strFieldName = "" Or strTableName = "" Then
        Err.Raise vbObjectError + ERR_BLANK_IDENTIFIER_NAME, _
        "AddToScript_DeleteField", "Required criterion not entered. (Blank DatabaseID, TableName, or FieldName.)"
    End If
        
    Call LoadRecordsets
    If intSortOrder = 0 Then intSortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    
    mrsMaster.AddNew
    mrsMaster!DatabaseID = intDatabaseID
    mrsMaster!DataFileVersion = intDataFileVersion
    mrsMaster!SortOrder = intSortOrder
    mrsMaster!Action = DeleteFieldAction
    mrsMaster!TableName = strTableName
    
    mrsFields.AddNew
    mrsFields!CommandID = mrsMaster!CommandID
    mrsFields!FieldName = strFieldName
    
    mrsMaster.Save
    mrsFields.Save
    Call UnLoadRecordsets
End Sub

Public Sub AddToScript_DeleteTable( _
                                intDatabaseID As Integer, _
                                intDataFileVersion As Integer, _
                                strTableName As String, _
                                Optional intSortOrder As Integer)
    'ADD A RENAMING ACTION TO THE SCRIPT
    
    'Revision: 2010-02-01 SMerrill: used the Action constants instead of magic numbers.
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    
    If intDatabaseID = -1 Then
        Err.Raise vbObjectError + ERR_DELETE_COMMAND_CANT_BE_ASSIGNED_TO_CURRENTDB, _
        "AddToScript_DeleteTable", "The delete script action cannot be assigned to the current database."
    End If
    Call LoadRecordsets
    If intSortOrder = 0 Then intSortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    mrsMaster.AddNew
    mrsMaster!DatabaseID = intDatabaseID
    mrsMaster!DataFileVersion = intDataFileVersion
    mrsMaster!SortOrder = intSortOrder
    mrsMaster!Action = DeleteTableAction 'SMerrill8
    mrsMaster!TableName = strTableName
    mrsMaster!LinkToCurrentDB = True 'Remove this linked table when we remove it from the source file
    mrsMaster.Save
    Call UnLoadRecordsets
End Sub

Public Function fGetDatabasesListForComboBox( _
                    blnIncludeOptionForCurrentDB As Boolean _
                    , Optional strCurrentDBName As String = "   (Current DB)" _
                ) As String
    'Returns a list of databases parsed for a combo box
    Dim strTemp As String
    Call LoadRecordsets
    
    If blnIncludeOptionForCurrentDB Then strTemp = "-1;" & strCurrentDBName & ";"
    Do Until mrsDatabases.EOF = True
        strTemp = strTemp & mrsDatabases!DatabaseID & ";" & mrsDatabases!DatabaseID & " - " & mrsDatabases!dbName & ";"
        mrsDatabases.MoveNext
    Loop
    fGetDatabasesListForComboBox = strTemp
    
    Call UnLoadRecordsets
End Function

Public Function fGetDataFileVersionsListForComboBox() As String
    Dim rs As New ADODB.Recordset
    Dim intVersionsList() As Integer
    Dim i As Integer
    Dim strTemp As String
    
    'LOAD VERSIONS LIST
    intVersionsList = fGetDataFileVersionsList
    
    For i = 0 To UBound(intVersionsList)
        strTemp = strTemp & intVersionsList(i) & ";" & intVersionsList(i) & ";"
    Next i
        
    strTemp = strTemp & intVersionsList(i - 1) + 1 & ";""" & intVersionsList(i - 1) + 1 & " - New Version""" & ";"
    fGetDataFileVersionsListForComboBox = strTemp
End Function

Public Sub AddToScript_SQLCommand( _
                intDatabaseID As Integer, _
                intDataFileVersion As Integer, _
                strSQLCommand As String, _
                Optional intSortOrder As Integer _
            )
    
    'Adds an EXECUTE SQL COMMAND action to the update script
    
    'Revision: 2010-02-01 SMerrill: used the Action constants instead of magic numbers.
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    
    If strSQLCommand = "" Then
        Err.Raise vbObjectError + ERR_BLANK_IDENTIFIER_NAME, "AddToScript_SQLCommand", _
            "The new SQL Command cannot be blank!"
        Exit Sub
    End If
    
    If intSortOrder = 0 Then intSortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    
    Call LoadRecordsets
    mrsMaster.AddNew
    mrsMaster!Action = RunSQLAction                 'SMerrill8
    mrsMaster!DatabaseID = intDatabaseID
    mrsMaster!DataFileVersion = intDataFileVersion
    mrsMaster!SortOrder = intSortOrder
    mrsMaster!SQLCommand = strSQLCommand
    mrsMaster.Update
    Call UnLoadRecordsets
End Sub


Public Sub AddToScript_SetPropertyAction( _
                intDatabaseID As Integer, _
                intAction As Integer, _
                intDataFileVersion As Integer, _
                strPropertyName As String, _
                intPropertyType As Integer, _
                strPropertyValue As String, _
                Optional strTableName As String, _
                Optional strFieldName As String, _
                Optional intSortOrder As Integer, _
                Optional blnAlsoSetInCurrentDB As Boolean _
            )
                
    'Adds a SET PROPERTY action to the update script
    
    'Revision: 2010-02-01 SMerrill: used the Action constants instead of magic numbers.
    'Revision: 2010-02-01 SMerrill: Used ErrorEnum Constants
    
    Dim intCommandID As Integer
    Dim intFieldID As Integer
    
    'VERIFY VARIABLES
    Select Case intAction
    Case SetDBProperty
        'Do nothing
    Case SetTableProperty
        If strTableName = "" Then Err.Raise vbObjectError + ERR_TABLENAME_CANNOT_BE_BLANK, _
        "AddToScript_SetPropertyAction", "Table Name Cannot Be Blank"
        
    Case SetFieldProperty
        If strTableName = "" Then Err.Raise vbObjectError + ERR_TABLENAME_CANNOT_BE_BLANK, _
        "AddToScript_SetPropertyAction", "Table Name Cannot Be Blank"
        
        If strFieldName = "" Then Err.Raise vbObjectError + ERR_FIELDNAME_CANNOT_BE_BLANK, _
        "AddToScript_SetPropertyAction", "Field Name Cannot Be Blank"
        
    Case Else
        Err.Raise vbObjectError + ERR_INVALID_ACTION, "AddToScript_SetPropertyAction", "Invalid Action Type"
    End Select
    
    Call LoadRecordsets
    'Prep the new record...
    mrsMaster.AddNew
    mrsMaster!Action = intAction
    mrsMaster!DatabaseID = intDatabaseID
    mrsMaster!TableName = strTableName
    mrsMaster!DatabaseID = intDatabaseID
    mrsMaster!LinkToCurrentDB = blnAlsoSetInCurrentDB
    mrsMaster!TableName = strTableName

    If intSortOrder = 0 Then
        mrsMaster!SortOrder = GetNextAvailableSortOrder(intDataFileVersion)
    Else
        mrsMaster!SortOrder = intSortOrder
    End If
    mrsMaster!DataFileVersion = intDataFileVersion
    intCommandID = mrsMaster!CommandID
    mrsMaster.Save
        
    'SET SPECIFIC PROPERTIES DEPENDING ON WHAT IT IS
    If intAction = SetFieldProperty Then
        mrsFields.AddNew
        mrsFields!CommandID = intCommandID
        mrsFields!FieldName = strFieldName
        intFieldID = mrsFields!FieldID
        mrsFields.Save
    End If
    
    'ADD THE PROPERTY TO BE SET TO THE DATABASE
    mrsProperties.AddNew
    mrsProperties!FieldID = mrsFields!FieldID
    mrsProperties!CommandID = intCommandID
    mrsProperties!PropertyName = strPropertyName
    mrsProperties!PropertyValue = strPropertyValue
    mrsProperties!PropertyType = intPropertyType
    mrsProperties.Save
    
    Call UnLoadRecordsets
End Sub

Public Function GetNextAvailableSortOrder(intDataFileVersion As Integer) As Integer
    'Returns the next highest sort order number. _
     For example, if there are 3 commands with sort order _
     of 1,2, and 4, the next sort order would be 5.
     
     
    GetNextAvailableSortOrder = Nz(DMax("SortOrder", BEUpdater_Master_Table_Name, _
                                    "DataFileVersion = " & intDataFileVersion), 0) + 1
End Function

Public Function GetHighestDataFileVersion() As Integer
    'Returns the highest DataFileVersion being used right now
    GetHighestDataFileVersion = Nz(DMax("DataFileVersion", BEUpdater_Master_Table_Name), BEUpdater_START_AT_VERSION)
End Function


Private Sub Class_Terminate()
'    Call UnloadDBs
'    If Not mrsMaster.ActiveConnection Is Nothing Then mrsMaster.Close
'    If Not mrsFields.ActiveConnection Is Nothing Then mrsFields.Close
'    If Not mrsProperties.ActiveConnection Is Nothing Then mrsProperties.Close
'    If Not mrsDatabases.ActiveConnection Is Nothing Then mrsDatabases.Close
    
    Set mrsMaster = Nothing
    Set mrsFields = Nothing
    Set mrsProperties = Nothing
    Set mrsDatabases = Nothing
End Sub

